home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 60.zip / BS1 part 60 / Kick Pascal v2.10 d2.adf / DEMO / Trackdiskdemo.p < prev    next >
Text File  |  1990-11-01  |  4KB  |  159 lines
  1. Program TrackdiskDemo;
  2.  
  3. Uses ExecIO;
  4.  
  5. {$incl 'devices/trackdisk.h' }
  6.  
  7.  
  8. Var port  : ^MsgPort;  { Zeiger auf Message-Port }
  9.     ioreq : ^IOExtTD;  { Zeiger auf erweiterte IO-Request-Struktur }
  10.  
  11.  
  12. Procedure OpenTrackdisk (Laufwerksnummer : integer);
  13.   Begin
  14.     port := CreatePort ('Disk-Device', 0);
  15.     ioreq := CreateExtIO (port, SizeOf(IOExtTD));
  16.     Open_Device ('trackdisk.device', Laufwerksnummer, ioreq, 0)
  17.   End;
  18.  
  19.  
  20. Procedure CloseTrackdisk;
  21.   Begin
  22.     Close_Device (ioreq);
  23.     DeleteExtIO (ioreq);
  24.     DeletePort (port)
  25.   End;
  26.  
  27.  
  28. Procedure MotorOn;
  29.   Var err: integer;
  30.   Begin
  31.     With ioreq^.iotd_req Do
  32.       Begin
  33.         io_Command := TD_MOTOR;
  34.         io_Length := 1;
  35.       End;
  36.     err := DoIO (ioreq)
  37.   End;
  38.  
  39.  
  40. Procedure MotorOff;
  41.   Var err: integer;
  42.   Begin
  43.     With ioreq^.iotd_req Do
  44.       Begin
  45.         io_Command := TD_MOTOR;
  46.         io_Length := 0;
  47.       End;
  48.     err := DoIO (ioreq)
  49.   End;
  50.  
  51.  
  52. Function DiskImLaufwerk : Boolean;
  53.   { Stellt fest, ob Disk in dem Laufwerk, für das das Device
  54.     geöffnet wurde. }
  55.   Var err : integer;
  56.   Begin
  57.     { Nur ein Befehl ohne Parameter: }
  58.     ioreq^.iotd_req.io_Command := TD_CHANGESTATE;
  59.     err := DoIO (ioreq);
  60.     { Rückgabe erfolgt in "io_Actual": }
  61.     DiskImLaufwerk := ioreq^.iotd_req.io_Actual = 0
  62.   End;
  63.  
  64.  
  65. Function Schreibschutz : Boolean;
  66.   { true, wenn Disk schreibgeschützt }
  67.   Var err : integer;
  68.   Begin
  69.     { Nur ein Befehl ohne Parameter: }
  70.     ioreq^.iotd_req.io_Command := TD_PROTSTATUS;
  71.     err := DoIO (ioreq);
  72.     { Rückgabe erfolgt in "io_Actual": }
  73.     Schreibschutz := ioreq^.iotd_req.io_Actual <> 0
  74.   End;
  75.  
  76.  
  77. Function Diskwechsel : Long;
  78.   { Gibt Anzahl der bisherigen Diskettenwechsel an. Der Zähler wird
  79.     sowohl beim Einlegen als auch beim Entnehmen einer Disk
  80.     hochgezählt! }
  81.   Var err : integer;
  82.   Begin
  83.     { Nur ein Befehl ohne Parameter: }
  84.     ioreq^.iotd_req.io_Command := TD_CHANGENUM;
  85.     err := DoIO (ioreq);
  86.     { Rückgabe erfolgt in "io_Actual": }
  87.     Diskwechsel := ioreq^.iotd_req.io_Actual
  88.   End;
  89.  
  90.  
  91. Procedure WriteHex (n: Long; digits:integer);
  92.   { Hexzahl n mit gewünschter Ziffernanzahl ausgeben }
  93.   Begin
  94.     If digits > 1 Then WriteHex (n shr 4, digits-1);
  95.     Write ('0123456789abcdef'.[n and 15 + 1])
  96.   End;
  97.  
  98.  
  99. Procedure LiesBlock (nr: integer);
  100.   { Einen Block lesen, z. B. 0 für Bootblock, 880 für Root..., und
  101.     als kombinierten Hex- und Asciidump ausgeben. }
  102.   Type
  103.     BufferTyp = Array[1..512] Of Byte;  { 1 Block = 512 Bytes }
  104.   Var
  105.     Buffer : ^Buffertyp;
  106.     i, j   : integer;
  107.     err    : integer;
  108.   Begin
  109.     Buffer := Ptr(Alloc_Mem(SizeOf(BufferTyp),2));  { Chip-RAM }
  110.     With ioreq^.iotd_req Do
  111.       Begin
  112.         io_Command := CMD_READ;
  113.         io_Data    := Buffer;
  114.         io_Length  := 512;
  115.         io_Offset  := 512 * nr  { Blockposition in Bytes }
  116.       End;
  117.     err := DoIO(ioreq);
  118.  
  119.     { Ergebnis ausgeben: }
  120.     If err <> 0 Then
  121.       Writeln ('Fehler: ', err)
  122.     Else
  123.       Begin
  124.         Writeln ('Inhalt von Block ', nr, ':');
  125.         Writeln;
  126.         For i:=0 to 31 Do     { 32 Zeilen zu 16 Bytes }
  127.           Begin
  128.             WriteHex (16*i,4); Write(': ');
  129.             For j:=1 to 16 Do
  130.               Begin WriteHex (Buffer^[16*i+j], 2); Write (' ') End;
  131.             Write ('  ');
  132.             For j:=1 to 16 Do
  133.               If Buffer^[16*i+j] in [32..127, 160..255] Then
  134.                 Write (Chr(Buffer^[16*i+j]))  { druckbare Zeichen ausgeben }
  135.               Else
  136.                 Write ('.');                  { sonst Punkt }
  137.             Writeln
  138.           End;
  139.       End;
  140.     Free_Mem (Long(Buffer), SizeOf(BufferTyp))
  141.   End;
  142.  
  143.  
  144. Var drive, block : integer;
  145.  
  146. Begin
  147.   Write ('Laufwerksnummer: '); Readln(drive);
  148.   OpenTrackDisk (drive);
  149.   If DiskImLaufwerk Then
  150.     Begin
  151.       Write ('Blocknummer:     '); Readln(block);
  152.       Writeln;
  153.       LiesBlock (block)
  154.     End
  155.   Else
  156.     Writeln ('Bedaure, da ist keine Disk ''drin!');
  157.   CloseTrackdisk
  158. End.
  159.